home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 9 / FM Towns Free Software Collection 9.iso / t_os / tool / grid / grid.bas next >
Encoding:
BASIC Source File  |  1994-11-16  |  6.3 KB  |  229 lines
  1. 1000 'グリッドロケーター
  2. 1010 '  1994/07/07 by 尋燐･ルナ
  3. 1020 :
  4. 1030 CLS
  5. 1040 DEFSTR A :DEFDBL D,Z
  6. 1050 SCREEN 1,0,1,1 :SCREEN@ 0 :WIDTH 80,25
  7. 1060 :
  8. 1070  GOSUB *画面
  9. 1080  GOSUB *初期設定
  10. 1090  GOSUB *東経
  11. 1100  GOSUB *北緯
  12. 1110  GOSUB *入力
  13. 1120  IF F=0 THEN 1170
  14. 1130   GOSUB *計算
  15. 1140   GOSUB *結果
  16. 1150  GOTO 1110
  17. 1160 :
  18. 1170 END
  19. 1180 :
  20. 1190 *初期設定
  21. 1200  RESTORE 1200
  22. 1210  DIM AX(7,2) :'数字入力
  23. 1220   FOR I0=0 TO 2
  24. 1230   FOR I=1 TO 7
  25. 1240    READ AX(I,I0)
  26. 1250   NEXT :NEXT
  27. 1260  DATA 0,3,6,3,9,4,1, 1,3,8,1,2,2,9, P,M,9,6,C,P," "
  28. 1270  GOSUB *結果
  29. 1280 RETURN
  30. 1290 :
  31. 1300 *計算
  32. 1310  T1=VAL(AX(1,1)+AX(2,1)+AX(3,1)) :T2=VAL(AX(4,1)+AX(5,1)) :T3=VAL(AX(6,1)+AX(7,1))
  33. 1320  H1=VAL(AX(2,0)+AX(3,0)) :H2=VAL(AX(4,0)+AX(5,0)) :H3=VAL(AX(6,0)+AX(7,0))
  34. 1330 :
  35. 1340  Z1=((T1+T2/60+T3/3600)+180)/20
  36. 1350  Z2=((H1+H2/60+H3/3600)+90)/10
  37. 1360 :
  38. 1370  D1=FIX(Z1)
  39. 1380  D2=FIX((Z1-D1)*10)
  40. 1390  D3=(Z1*10-FIX(Z1*10))*10
  41. 1400 :
  42. 1410  D4=FIX(Z2)
  43. 1420  D5=FIX((Z2-D4)*10)
  44. 1430  D6=(Z2*10-FIX(Z2*10))*10
  45. 1440 :
  46. 1450  D7=FIX(D3*2.4!)
  47. 1460  D8=FIX(D6*2.4!)
  48. 1470 :
  49. 1480  AX(1,2)=CHR$(D1+&H41) :AX(2,2)=CHR$(D4+&H41)
  50. 1490  AX(3,2)=CHR$(D2+&H30) :AX(4,2)=CHR$(D5+&H30)
  51. 1500  AX(5,2)=CHR$(D7+&H41) :AX(6,2)=CHR$(D8+&H41)
  52. 1510 :
  53. 1520 IF F=1 THEN RETURN
  54. 1530 'test用表示
  55. 1540  SCREEN 0:
  56. 1550  PRINT T1,T2,T3
  57. 1560  PRINT H1,H2,H3
  58. 1570  PRINT  "Z1=";Z1
  59. 1580  PRINT  "Z2=";Z2
  60. 1590  PRINT  "D1=";D1
  61. 1600  PRINT  "D2=";D2
  62. 1610  PRINT  "D3=";D3
  63. 1620  PRINT  "D4=";D4
  64. 1630  PRINT  "D5=";D5
  65. 1640  PRINT  "D6=";D6
  66. 1650  PRINT  "D7=";D7
  67. 1660  PRINT  "D8=";D8
  68. 1670  A=INPUT$(1)
  69. 1680  SCREEN 1,0,1
  70. 1690 RETURN
  71. 1700 :
  72. 1710 *画面
  73. 1720  CLS
  74. 1730  LINE (0,0)-(639,479),PSET,%5,BF,&H4040404004040404
  75. 1740  CONNECT (1,479)-(1,1)-(639,1),%5
  76. 1750  SYMBOL (10,10),"アマチュア無線",1,1,5,,,5
  77. 1760  SYMBOL (10,33),"グリッドロケーター の計算",2,1,6,,,5,2
  78. 1770  SYMBOL (500,35),"by 尋燐･ルナ",1,1,5,,,7
  79. 1780  SYMBOL (460,10),"Vol 1.1  1994/07/07",1,1,4,,,5
  80. 1790  LINE (0,60)-(639,61),PRESET,,B
  81. 1800  LINE (1,62)-(639,63),PSET,%5,B
  82. 1810  LINE (0,320)-(639,321),PRESET,,B
  83. 1820  LINE (1,322)-(639,323),PSET,%5,B
  84. 1830  RESTORE 1830
  85. 1840  GOSUB *BOX :GOSUB *BOX
  86. 1850  SYMBOL (250,220),"調べたい場所の東経･北緯を入力してください。",1,1,7
  87. 1860  SYMBOL (220,265),"使用キー",1,1,5,,,1
  88. 1870  SYMBOL (316,255),"計算 = 実行     移動 = カーソル",1,1,4
  89. 1880  SYMBOL (316,275),"終了 = ESC      入力 = ０ - ９",1,1,4
  90. 1890  SYMBOL (350,90),"o",1,1,7,,,5 :SYMBOL (480,95),"’",1,1,7,,,5
  91. 1900  SYMBOL (610,95),"’",1,1,7,,,5 :SYMBOL (617,95),"’",1,1,7,,,5
  92. 1910  SYMBOL (350,150),"o",1,1,7,,,5 :SYMBOL (480,155),"’",1,1,7,,,5
  93. 1920  SYMBOL (610,155),"’",1,1,7,,,5 :SYMBOL (617,155),"’",1,1,7,,,5
  94. 1930 RETURN
  95. 1940 DATA 210,285,290,285,0, 290,285,290,260,0, 210,285,210,260,5, 210,260,290,260,5
  96. 1950 DATA 200,300,580,300,5, 580,300,580,245,5, 200,300,200,245,0, 200,245,580,245,0
  97. 1960 :
  98. 1970 *東経
  99. 1980  A="東 経" :P=1
  100. 1990  GOSUB *表示
  101. 2000 RETURN
  102. 2010 :
  103. 2020 *北緯
  104. 2030  A="北 緯" :P=0
  105. 2040  GOSUB *表示
  106. 2050 RETURN
  107. 2060 :
  108. 2070 *表示
  109. 2080  IF P THEN Y=100 ELSE Y=160
  110. 2090  SYMBOL (70,Y),A,2,2,7,,,5
  111. 2100  GOSUB *ALL_P
  112. 2110 RETURN
  113. 2120 :
  114. 2130 *入力
  115. 2140  P=1 :L=1 :F=0
  116. 2150  GOSUB *反転
  117. 2160  A=INPUT$(1)
  118. 2170   IF A=CHR$(13) THEN F=1 :GOTO *E_入力
  119. 2180   IF A=CHR$(27) THEN F=0 :GOTO *E_入力
  120. 2190   IF A="T" OR A="t" THEN F=2 :GOTO *E_入力
  121. 2200   IF A="C" THEN CLS 4 :GOTO 2160
  122. 2210   IF A="F" OR A="f" THEN GOSUB *友 :GOTO 2160
  123. 2220   IF A=CHR$(28) THEN I=1 :GOTO *カーソル
  124. 2230   IF A=CHR$(29) THEN I=-1 :GOTO *カーソル
  125. 2240   IF A=CHR$(30) THEN I=0 :GOTO *カーソル
  126. 2250   IF A=CHR$(31) THEN I=0 :GOTO *カーソル
  127. 2260  IF A<"0" OR A>"9" THEN BEEP :GOTO 2160 ELSE I=VAL(A)
  128. 2270 'チェック
  129. 2280  IF L=4 OR L=6 THEN IF I>5 THEN BEEP :GOTO 2160
  130. 2290  IF L=1 AND I>1 THEN BEEP :GOTO 2160
  131. 2300 :
  132. 2310  AX(L,P)=A
  133. 2320  GOSUB *A_表示
  134. 2330  I=1
  135. 2340 GOTO 2420
  136. 2350 :
  137. 2360 *E_入力
  138. 2370  GOSUB *反転
  139. 2380 RETURN
  140. 2390 :
  141. 2400 *カーソル
  142. 2410  GOSUB *反転
  143. 2420  IF I=0 THEN P=-(P=0) ELSE L=L+I
  144. 2430  IF L<1 THEN P=-(P=0) :L=7
  145. 2440  IF L>7 THEN P=-(P=0) :L=1
  146. 2450  IF I>-1 AND L=1 AND P=0 THEN L=2
  147. 2460  IF I=-1 AND L=1 AND P=0 THEN L=7 :P=1
  148. 2470 GOTO 2150
  149. 2480 :
  150. 2490 *反転
  151. 2500  X=150+L*50 :Y=100-(P=0)*60
  152. 2510  X=X-(L>3)*30-(L>5)*30
  153. 2520  LINE (X,Y-3)-(X+41,Y+38),XOR,%5,B
  154. 2530  LINE (X+1,Y-2)-(X+40,Y+37),XOR,%5,B
  155. 2540 RETURN
  156. 2550 :
  157. 2560 *ALL_P
  158. 2570  X=150
  159. 2580   FOR I=1 TO 7
  160. 2590    X=X+50
  161. 2600    IF I=4 OR I=6 THEN X=X+30
  162. 2610    IF I=1 AND P=0 THEN 2630
  163. 2620    L=I :GOSUB *A_表示
  164. 2630   NEXT
  165. 2640 RETURN
  166. 2650 :
  167. 2660 *A_表示
  168. 2670  RESTORE 2670
  169. 2680  LINE (X,Y-3)-(X+40,Y+37),PSET,0,BF,&H4040404004040404
  170. 2690  GOSUB *BOX
  171. 2700  SYMBOL (X+6,Y+2),AKCNV$(AX(L,P)),2,2,5,,,1
  172. 2710 RETURN
  173. 2720 DATA  40,-3,40,37,0  ,0,37,40,37,0  ,0,-3,40,-3,5  ,0,-3,0,37,5
  174. 2730 :
  175. 2740 *BOX
  176. 2750   FOR I0=1 TO 4
  177. 2760    READ I1,I2,I3,I4,I5
  178. 2770    LINE (X+I1,Y+I2)-(X+I3,Y+I4),PSET,%I5,B
  179. 2780    LINE (X+I1+1,Y+I2+1)-(X+I3+1,Y+I4+1),PSET,%I5,B
  180. 2790   NEXT
  181. 2800 RETURN
  182. 2810 :
  183. 2820 *結果
  184. 2830  SYMBOL (30,335),"お調べのグリッドロケーターは、",1,1,6,,,3,3
  185. 2840  SYMBOL (500,435),"となりました。",1,1,6,,,3,3
  186. 2850  X=0 :Y=360 :P=2
  187. 2860  FOR I=1 TO 6
  188. 2870   X=X+80
  189. 2880    L=I :GOSUB *AN_表示
  190. 2890  NEXT
  191. 2900 :
  192. 2910 *AN_表示
  193. 2920  RESTORE 2920
  194. 2930  LINE (X,Y)-(X+60,Y+60),PSET,0,BF,&H4040404004040404
  195. 2940  GOSUB *BOX
  196. 2950  SYMBOL (X+7,Y+8),AKCNV$(AX(L,P)),3,3,5,,,1
  197. 2960 RETURN
  198. 2970 DATA  60,0,60,60,0  ,0,60,60,60,0  ,0,0,60,0,5  ,0,0,0,60,5
  199. 2980 :
  200. 2990 *友
  201. 3000  SCREEN 1,1,3
  202. 3010  LINE (200,130)-(450,400),PSET,%7,BF
  203. 3020  LINE (200,130)-(450,400),PSET,7,B
  204. 3030  RESTORE 3030 :X=210 :Y=140
  205. 3040   READ A
  206. 3050   IF A="END" THEN 3090
  207. 3060   SYMBOL (X,Y),A,1,1,6,,,1
  208. 3070   Y=Y+20
  209. 3080  GOTO 3040
  210. 3090 :A=INPUT$(1)
  211. 3100  SCREEN 1,0,1
  212. 3110 RETURN
  213. 3120 DATA "製作者　　：ＪＧ０ＱＫＲ"
  214. 3130 DATA "協力者　　：ＪＧ０ＱＫＳ"
  215. 3140 DATA "フレンド局：ＪＧ０ＢＶＺ"
  216. 3150 DATA "　　　　　　ＪＧ０ＰＭＵ"
  217. 3160 DATA "　　　　　　ＪＧ０ＴＤＶ"
  218. 3170 DATA "　　　　　　ＪＧ０ＸＢＩ"
  219. 3180 DATA "　　　　　　ＪＩ０ＦＬＳ"
  220. 3190 DATA "その他　　：のりＰ"
  221. 3200 DATA "　　　　　　まーすけ"
  222. 3210 DATA "　　　　　　ゴルゴ小林"
  223. 3220 DATA "長野市に遊びに来られましたら"
  224. 3230 DATA "    430Mにてお声掛けください。"
  225. 3240 DATA "                     尋燐･ルナ"
  226. 3250 DATA "END"
  227. 3260 :
  228. 3270 '----------- E N D ------------------
  229.